home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / product.arc / MACRO35.LSP < prev    next >
Encoding:
Text File  |  1986-09-21  |  1.8 KB  |  62 lines
  1. (Defun C:Ctc ()
  2.        (Setvar "Cmdecho" 0)
  3.        (Setq BLIP (Getvar "Blipmode"))
  4.        (Setvar "Blipmode" 0)
  5.        (Setq R3 (Getreal "\nEnter fillet radius: "))
  6.        (Setq C1 (Osnap (Setq E1 (Osnap (Getpoint
  7.                 "\nTouch 1st circle: ")"Nea"))"Cen"))
  8.        (Setq C2 (Osnap (Setq E2 (Osnap (Getpoint
  9.                 "\nTouch 2nd circle: ")"Nea"))"Cen"))
  10.        (Setq CC (Distance C1 C2))
  11.        (Setq EE (Distance E1 E2))
  12.        (Setq A1 (Angle C1 C2))
  13.        (Setq R1 (Distance C1 E1))
  14.        (Setq R2 (Distance C2 E2))
  15.        (Setq Q (- CC (+ R1 R2)))
  16.        (If (< R3 Q)
  17.            (Progn
  18.                 (Prompt "\nFillet radius must be at least ")
  19.                 (Princ Q) (Setq R3 (Getreal ", new radius: "))
  20.            )
  21.        )
  22.        (If (> EE CC)
  23.            (Progn
  24.                 (Setq X (- R3 R1))
  25.                 (Setq Y (- R3 R2))
  26.            )
  27.            (Progn
  28.                 (Setq X (+ R3 R1))
  29.                 (Setq Y (+ R3 R2))
  30.            )
  31.        )
  32.        (Setq COSA (/ (- (+ (* X X) (* CC CC))
  33.                   (* Y Y)) (* 2 X CC)))
  34.        (Setq B (* COSA X))
  35.        (Setq Z (- CC B))
  36.        (Setq B1 (Abs Z))
  37.        (Setq A (Sqrt (- (* X X) (* B B))))
  38.        (Setq A2 (Abs (Atan (/ A B))))
  39.        (Setq A3 (Atan (/ A B1)))
  40.        (Setq A4 
  41.              (If (< EE CC)
  42.                  (+ A1 A2)
  43.                  (If (> Z 0)
  44.                      (+ A1 Pi A3)
  45.                      (- A1 A3)
  46.                  )
  47.              )
  48.        )
  49.        (Command "Arc" "C" 
  50.              (If (< EE CC)
  51.                  (Polar C1 A4 X)
  52.                  (Polar C2 A4 Y)
  53.              )
  54.              (If (< EE CC)
  55.                  (Polar C1 A4 R1)
  56.                  (Polar C2 (+ A4 Pi) R2)
  57.              )
  58.              (If (< EE CC) C2 C1)
  59.        )
  60.        (Setvar "Blipmode" BLIP)
  61. )
  62.